home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / gnu_tile_forth.lha / tst / ranges.tst < prev    next >
Text File  |  1992-05-19  |  1KB  |  72 lines
  1. .( Loading Ranges test...) cr
  2.  
  3. #include ranges.f83
  4. #include blocks.f83
  5.  
  6. blocks ranges 
  7.  
  8.  
  9. .( 1: Create some typical ranges and print them) cr
  10.  
  11. [1901..2001] range YEAR_NUMBER ( -- from to)
  12. [1..12]      range MONTH_NUMBER ( -- from to)
  13. [1..31]      range DAY_NUMBER ( -- from to)
  14. [1..24]      range HOUR_NUMBER ( -- from to)
  15. [1..60]      range MINUTE_NUMBER ( -- from to)
  16. [1..60]      range SECOND_NUMBER ( -- from to)
  17.  
  18. MONTH_NUMBER . . cr
  19. YEAR_NUMBER . . cr
  20. DAY_NUMBER . . cr
  21.  
  22.  
  23. .( 2: Count number of odd numbers in the ranges) cr
  24.  
  25. : count-odd-numbers ( from to -- n)
  26.   0 -rot
  27.   block[ ( count index -- count+1)
  28.     1 and if 1+ then
  29.   ];
  30.   map-range
  31. ; 
  32.  
  33. YEAR_NUMBER count-odd-numbers . 
  34. MONTH_NUMBER count-odd-numbers .
  35. DAY_NUMBER count-odd-numbers . cr
  36.  
  37.  
  38. .( 3: Test membership function) cr
  39.  
  40. 3 YEAR_NUMBER ?member-range .
  41. 3 MONTH_NUMBER ?member-range .
  42. 3 DAY_NUMBER ?member-range . cr
  43.  
  44.  
  45. .( 4: Conditional iteration; print a sub-range) cr
  46.  
  47. : 3dup ( x y z -- x y z x y z)
  48.   >r 2dup r@ -rot r>
  49. ;
  50.  
  51. : .sub.range ( upper from to -- )
  52.   3dup ?member-range
  53.   if block[ dup . over = ]; ?map-range
  54.   else
  55.     2drop 
  56.   then
  57.   drop
  58. ;
  59.  
  60. 4 DAY_NUMBER .sub.range cr
  61.  
  62.  
  63. .( 5: Union and intersections of ranges) cr
  64.  
  65. DAY_NUMBER YEAR_NUMBER ?intersection-range . cr
  66. DAY_NUMBER MONTH_NUMBER intersection-range .range cr
  67. DAY_NUMBER MONTH_NUMBER union-range .range cr
  68.  
  69. forth only
  70.  
  71.  
  72.